home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Utilities / Ghostscript / src / zdouble.c < prev    next >
Encoding:
C/C++ Source or Header  |  2001-01-01  |  12.3 KB  |  540 lines
  1. /* Copyright (C) 1995, 1996, 1998, 1999 Aladdin Enterprises.  All rights reserved.
  2.   
  3.   This file is part of AFPL Ghostscript.
  4.   
  5.   AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
  6.   distributor accepts any responsibility for the consequences of using it, or
  7.   for whether it serves any particular purpose or works at all, unless he or
  8.   she says so in writing.  Refer to the Aladdin Free Public License (the
  9.   "License") for full details.
  10.   
  11.   Every copy of AFPL Ghostscript must include a copy of the License, normally
  12.   in a plain ASCII text file named PUBLIC.  The License grants you the right
  13.   to copy, modify and redistribute AFPL Ghostscript, but only under certain
  14.   conditions described in the License.  Among other things, the License
  15.   requires that the copyright notice and this notice be preserved on all
  16.   copies.
  17. */
  18.  
  19. /*$Id: zdouble.c,v 1.2 2000/09/19 19:00:53 lpd Exp $ */
  20. /* Double-precision floating point arithmetic operators */
  21. #include "math_.h"
  22. #include "memory_.h"
  23. #include "string_.h"
  24. #include "ctype_.h"
  25. #include "ghost.h"
  26. #include "gxfarith.h"
  27. #include "oper.h"
  28. #include "store.h"
  29.  
  30. /*
  31.  * Thanks to Jean-Pierre Demailly of the Institut Fourier of the
  32.  * Universit\'e de Grenoble I <demailly@fourier.grenet.fr> for proposing
  33.  * this package and for arranging the funding for its creation.
  34.  *
  35.  * These operators work with doubles represented as 8-byte strings.  When
  36.  * applicable, they write their result into a string supplied as an argument.
  37.  * They also accept ints and reals as arguments.
  38.  */
  39.  
  40. /* Forward references */
  41. private int double_params_result(P3(os_ptr, int, double *));
  42. private int double_params(P3(os_ptr, int, double *));
  43. private int double_result(P3(i_ctx_t *, int, double));
  44. private int double_unary(P2(i_ctx_t *, double (*)(P1(double))));
  45.  
  46. #define dbegin_unary()\
  47.     os_ptr op = osp;\
  48.     double num;\
  49.     int code = double_params_result(op, 1, &num);\
  50. \
  51.     if ( code < 0 )\
  52.       return code
  53.  
  54. #define dbegin_binary()\
  55.     os_ptr op = osp;\
  56.     double num[2];\
  57.     int code = double_params_result(op, 2, num);\
  58. \
  59.     if ( code < 0 )\
  60.       return code
  61.  
  62. /* ------ Arithmetic ------ */
  63.  
  64. /* <dnum1> <dnum2> <dresult> .dadd <dresult> */
  65. private int
  66. zdadd(i_ctx_t *i_ctx_p)
  67. {
  68.     dbegin_binary();
  69.     return double_result(i_ctx_p, 2, num[0] + num[1]);
  70. }
  71.  
  72. /* <dnum1> <dnum2> <dresult> .ddiv <dresult> */
  73. private int
  74. zddiv(i_ctx_t *i_ctx_p)
  75. {
  76.     dbegin_binary();
  77.     if (num[1] == 0.0)
  78.     return_error(e_undefinedresult);
  79.     return double_result(i_ctx_p, 2, num[0] / num[1]);
  80. }
  81.  
  82. /* <dnum1> <dnum2> <dresult> .dmul <dresult> */
  83. private int
  84. zdmul(i_ctx_t *i_ctx_p)
  85. {
  86.     dbegin_binary();
  87.     return double_result(i_ctx_p, 2, num[0] * num[1]);
  88. }
  89.  
  90. /* <dnum1> <dnum2> <dresult> .dsub <dresult> */
  91. private int
  92. zdsub(i_ctx_t *i_ctx_p)
  93. {
  94.     dbegin_binary();
  95.     return double_result(i_ctx_p, 2, num[0] - num[1]);
  96. }
  97.  
  98. /* ------ Simple functions ------ */
  99.  
  100. /* <dnum> <dresult> .dabs <dresult> */
  101. private int
  102. zdabs(i_ctx_t *i_ctx_p)
  103. {
  104.     return double_unary(i_ctx_p, fabs);
  105. }
  106.  
  107. /* <dnum> <dresult> .dceiling <dresult> */
  108. private int
  109. zdceiling(i_ctx_t *i_ctx_p)
  110. {
  111.     return double_unary(i_ctx_p, ceil);
  112. }
  113.  
  114. /* <dnum> <dresult> .dfloor <dresult> */
  115. private int
  116. zdfloor(i_ctx_t *i_ctx_p)
  117. {
  118.     return double_unary(i_ctx_p, floor);
  119. }
  120.  
  121. /* <dnum> <dresult> .dneg <dresult> */
  122. private int
  123. zdneg(i_ctx_t *i_ctx_p)
  124. {
  125.     dbegin_unary();
  126.     return double_result(i_ctx_p, 1, -num);
  127. }
  128.  
  129. /* <dnum> <dresult> .dround <dresult> */
  130. private int
  131. zdround(i_ctx_t *i_ctx_p)
  132. {
  133.     dbegin_unary();
  134.     return double_result(i_ctx_p, 1, floor(num + 0.5));
  135. }
  136.  
  137. /* <dnum> <dresult> .dsqrt <dresult> */
  138. private int
  139. zdsqrt(i_ctx_t *i_ctx_p)
  140. {
  141.     dbegin_unary();
  142.     if (num < 0.0)
  143.     return_error(e_rangecheck);
  144.     return double_result(i_ctx_p, 1, sqrt(num));
  145. }
  146.  
  147. /* <dnum> <dresult> .dtruncate <dresult> */
  148. private int
  149. zdtruncate(i_ctx_t *i_ctx_p)
  150. {
  151.     dbegin_unary();
  152.     return double_result(i_ctx_p, 1, (num < 0 ? ceil(num) : floor(num)));
  153. }
  154.  
  155. /* ------ Transcendental functions ------ */
  156.  
  157. private int
  158. darc(i_ctx_t *i_ctx_p, double (*afunc)(P1(double)))
  159. {
  160.     dbegin_unary();
  161.     return double_result(i_ctx_p, 1, (*afunc)(num) * radians_to_degrees);
  162. }
  163. /* <dnum> <dresult> .darccos <dresult> */
  164. private int
  165. zdarccos(i_ctx_t *i_ctx_p)
  166. {
  167.     return darc(i_ctx_p, acos);
  168. }
  169. /* <dnum> <dresult> .darcsin <dresult> */
  170. private int
  171. zdarcsin(i_ctx_t *i_ctx_p)
  172. {
  173.     return darc(i_ctx_p, asin);
  174. }
  175.  
  176. /* <dnum> <ddenom> <dresult> .datan <dresult> */
  177. private int
  178. zdatan(i_ctx_t *i_ctx_p)
  179. {
  180.     double result;
  181.  
  182.     dbegin_binary();
  183.     if (num[0] == 0) {        /* on X-axis, special case */
  184.     if (num[1] == 0)
  185.         return_error(e_undefinedresult);
  186.     result = (num[1] < 0 ? 180 : 0);
  187.     } else {
  188.     result = atan2(num[0], num[1]) * radians_to_degrees;
  189.     if (result < 0)
  190.         result += 360;
  191.     }
  192.     return double_result(i_ctx_p, 2, result);
  193. }
  194.  
  195. /* <dnum> <dresult> .dcos <dresult> */
  196. private int
  197. zdcos(i_ctx_t *i_ctx_p)
  198. {
  199.     return double_unary(i_ctx_p, gs_cos_degrees);
  200. }
  201.  
  202. /* <dbase> <dexponent> <dresult> .dexp <dresult> */
  203. private int
  204. zdexp(i_ctx_t *i_ctx_p)
  205. {
  206.     double ipart;
  207.  
  208.     dbegin_binary();
  209.     if (num[0] == 0.0 && num[1] == 0.0)
  210.     return_error(e_undefinedresult);
  211.     if (num[0] < 0.0 && modf(num[1], &ipart) != 0.0)
  212.     return_error(e_undefinedresult);
  213.     return double_result(i_ctx_p, 2, pow(num[0], num[1]));
  214. }
  215.  
  216. private int
  217. dlog(i_ctx_t *i_ctx_p, double (*lfunc)(P1(double)))
  218. {
  219.     dbegin_unary();
  220.     if (num <= 0.0)
  221.     return_error(e_rangecheck);
  222.     return double_result(i_ctx_p, 1, (*lfunc)(num));
  223. }
  224. /* <dposnum> <dresult> .dln <dresult> */
  225. private int
  226. zdln(i_ctx_t *i_ctx_p)
  227. {
  228.     return dlog(i_ctx_p, log);
  229. }
  230. /* <dposnum> <dresult> .dlog <dresult> */
  231. private int
  232. zdlog(i_ctx_t *i_ctx_p)
  233. {
  234.     return dlog(i_ctx_p, log10);
  235. }
  236.  
  237. /* <dnum> <dresult> .dsin <dresult> */
  238. private int
  239. zdsin(i_ctx_t *i_ctx_p)
  240. {
  241.     return double_unary(i_ctx_p, gs_sin_degrees);
  242. }
  243.  
  244. /* ------ Comparison ------ */
  245.  
  246. private int
  247. dcompare(i_ctx_t *i_ctx_p, int mask)
  248. {
  249.     os_ptr op = osp;
  250.     double num[2];
  251.     int code = double_params(op, 2, num);
  252.  
  253.     if (code < 0)
  254.     return code;
  255.     make_bool(op - 1,
  256.           (mask & (num[0] < num[1] ? 1 : num[0] > num[1] ? 4 : 2))
  257.           != 0);
  258.     pop(1);
  259.     return 0;
  260. }
  261. /* <dnum1> <dnum2> .deq <bool> */
  262. private int
  263. zdeq(i_ctx_t *i_ctx_p)
  264. {
  265.     return dcompare(i_ctx_p, 2);
  266. }
  267. /* <dnum1> <dnum2> .dge <bool> */
  268. private int
  269. zdge(i_ctx_t *i_ctx_p)
  270. {
  271.     return dcompare(i_ctx_p, 6);
  272. }
  273. /* <dnum1> <dnum2> .dgt <bool> */
  274. private int
  275. zdgt(i_ctx_t *i_ctx_p)
  276. {
  277.     return dcompare(i_ctx_p, 4);
  278. }
  279. /* <dnum1> <dnum2> .dle <bool> */
  280. private int
  281. zdle(i_ctx_t *i_ctx_p)
  282. {
  283.     return dcompare(i_ctx_p, 3);
  284. }
  285. /* <dnum1> <dnum2> .dlt <bool> */
  286. private int
  287. zdlt(i_ctx_t *i_ctx_p)
  288. {
  289.     return dcompare(i_ctx_p, 1);
  290. }
  291. /* <dnum1> <dnum2> .dne <bool> */
  292. private int
  293. zdne(i_ctx_t *i_ctx_p)
  294. {
  295.     return dcompare(i_ctx_p, 5);
  296. }
  297.  
  298. /* ------ Conversion ------ */
  299.  
  300. /* Take the easy way out.... */
  301. #define MAX_CHARS 50
  302.  
  303. /* <dnum> <dresult> .cvd <dresult> */
  304. private int
  305. zcvd(i_ctx_t *i_ctx_p)
  306. {
  307.     dbegin_unary();
  308.     return double_result(i_ctx_p, 1, num);
  309. }
  310.  
  311. /* <string> <dresult> .cvsd <dresult> */
  312. private int
  313. zcvsd(i_ctx_t *i_ctx_p)
  314. {
  315.     os_ptr op = osp;
  316.     int code = double_params_result(op, 0, NULL);
  317.     double num;
  318.     char buf[MAX_CHARS + 2];
  319.     char *str = buf;
  320.     uint len;
  321.     char end;
  322.  
  323.     if (code < 0)
  324.     return code;
  325.     check_read_type(op[-1], t_string);
  326.     len = r_size(op - 1);
  327.     if (len > MAX_CHARS)
  328.     return_error(e_limitcheck);
  329.     memcpy(str, op[-1].value.bytes, len);
  330.     /*
  331.      * We check syntax in the following way: we remove whitespace,
  332.      * verify that the string contains only [0123456789+-.dDeE],
  333.      * then append a $ and then check that the next character after
  334.      * the scanned number is a $.
  335.      */
  336.     while (len > 0 && isspace(*str))
  337.     ++str, --len;
  338.     while (len > 0 && isspace(str[len - 1]))
  339.     --len;
  340.     str[len] = 0;
  341.     if (strspn(str, "0123456789+-.dDeE") != len)
  342.     return_error(e_syntaxerror);
  343.     strcat(str, "$");
  344.     if (sscanf(str, "%lf%c", &num, &end) != 2 || end != '$')
  345.     return_error(e_syntaxerror);
  346.     return double_result(i_ctx_p, 1, num);
  347. }
  348.  
  349. /* <dnum> .dcvi <int> */
  350. private int
  351. zdcvi(i_ctx_t *i_ctx_p)
  352. {
  353.     os_ptr op = osp;
  354. #define alt_min_long (-1L << (arch_sizeof_long * 8 - 1))
  355. #define alt_max_long (~(alt_min_long))
  356.     static const double min_int_real = (alt_min_long * 1.0 - 1);
  357.     static const double max_int_real = (alt_max_long * 1.0 + 1);
  358.     double num;
  359.     int code = double_params(op, 1, &num);
  360.  
  361.     if (code < 0)
  362.     return code;
  363.  
  364.     if (num < min_int_real || num > max_int_real)
  365.     return_error(e_rangecheck);
  366.     make_int(op, (long)num);    /* truncates toward 0 */
  367.     return 0;
  368. }
  369.  
  370. /* <dnum> .dcvr <real> */
  371. private int
  372. zdcvr(i_ctx_t *i_ctx_p)
  373. {
  374.     os_ptr op = osp;
  375. #define b30 (0x40000000L * 1.0)
  376. #define max_mag (0xffffff * b30 * b30 * b30 * 0x4000)
  377.     static const float min_real = -max_mag;
  378.     static const float max_real = max_mag;
  379. #undef b30
  380. #undef max_mag
  381.     double num;
  382.     int code = double_params(op, 1, &num);
  383.  
  384.     if (code < 0)
  385.     return code;
  386.     if (num < min_real || num > max_real)
  387.     return_error(e_rangecheck);
  388.     make_real(op, (float)num);
  389.     return 0;
  390. }
  391.  
  392. /* <dnum> <string> .dcvs <substring> */
  393. private int
  394. zdcvs(i_ctx_t *i_ctx_p)
  395. {
  396.     os_ptr op = osp;
  397.     double num;
  398.     int code = double_params(op - 1, 1, &num);
  399.     char str[MAX_CHARS + 1];
  400.     int len;
  401.  
  402.     if (code < 0)
  403.     return code;
  404.     check_write_type(*op, t_string);
  405.     /*
  406.      * To get fully accurate output results for IEEE double-
  407.      * precision floats (53 bits of mantissa), the ANSI
  408.      * %g default of 6 digits is not enough; 16 are needed.
  409.      * Unfortunately, using %.16g produces unfortunate artifacts such as
  410.      * 1.2 printing as 1.200000000000005.  Therefore, we print using %g,
  411.      * and if the result isn't accurate enough, print again
  412.      * using %.16g.
  413.      */
  414.     {
  415.     double scanned;
  416.  
  417.     sprintf(str, "%g", num);
  418.     sscanf(str, "%lf", &scanned);
  419.     if (scanned != num)
  420.         sprintf(str, "%.16g", num);
  421.     }
  422.     len = strlen(str);
  423.     if (len > r_size(op))
  424.     return_error(e_rangecheck);
  425.     memcpy(op->value.bytes, str, len);
  426.     op[-1] = *op;
  427.     r_set_size(op - 1, len);
  428.     pop(1);
  429.     return 0;
  430. }
  431.  
  432. /* ------ Initialization table ------ */
  433.  
  434. /* We need to split the table because of the 16-element limit. */
  435. const op_def zdouble1_op_defs[] = {
  436.         /* Arithmetic */
  437.     {"3.dadd", zdadd},
  438.     {"3.ddiv", zddiv},
  439.     {"3.dmul", zdmul},
  440.     {"3.dsub", zdsub},
  441.         /* Comparison */
  442.     {"2.deq", zdeq},
  443.     {"2.dge", zdge},
  444.     {"2.dgt", zdgt},
  445.     {"2.dle", zdle},
  446.     {"2.dlt", zdlt},
  447.     {"2.dne", zdne},
  448.         /* Conversion */
  449.     {"2.cvd", zcvd},
  450.     {"2.cvsd", zcvsd},
  451.     {"1.dcvi", zdcvi},
  452.     {"1.dcvr", zdcvr},
  453.     {"2.dcvs", zdcvs},
  454.     op_def_end(0)
  455. };
  456. const op_def zdouble2_op_defs[] = {
  457.         /* Simple functions */
  458.     {"2.dabs", zdabs},
  459.     {"2.dceiling", zdceiling},
  460.     {"2.dfloor", zdfloor},
  461.     {"2.dneg", zdneg},
  462.     {"2.dround", zdround},
  463.     {"2.dsqrt", zdsqrt},
  464.     {"2.dtruncate", zdtruncate},
  465.         /* Transcendental functions */
  466.     {"2.darccos", zdarccos},
  467.     {"2.darcsin", zdarcsin},
  468.     {"3.datan", zdatan},
  469.     {"2.dcos", zdcos},
  470.     {"3.dexp", zdexp},
  471.     {"2.dln", zdln},
  472.     {"2.dlog", zdlog},
  473.     {"2.dsin", zdsin},
  474.     op_def_end(0)
  475. };
  476.  
  477. /* ------ Internal procedures ------ */
  478.  
  479. /* Get some double arguments. */
  480. private int
  481. double_params(os_ptr op, int count, double *pval)
  482. {
  483.     pval += count;
  484.     while (--count >= 0) {
  485.     switch (r_type(op)) {
  486.         case t_real:
  487.         *--pval = op->value.realval;
  488.         break;
  489.         case t_integer:
  490.         *--pval = op->value.intval;
  491.         break;
  492.         case t_string:
  493.         if (!r_has_attr(op, a_read) ||
  494.             r_size(op) != sizeof(double)
  495.         )
  496.                    return_error(e_typecheck);
  497.         --pval;
  498.         memcpy(pval, op->value.bytes, sizeof(double));
  499.         break;
  500.         case t__invalid:
  501.         return_error(e_stackunderflow);
  502.         default:
  503.         return_error(e_typecheck);
  504.     }
  505.     op--;
  506.     }
  507.     return 0;
  508. }
  509.  
  510. /* Get some double arguments, and check for a double result. */
  511. private int
  512. double_params_result(os_ptr op, int count, double *pval)
  513. {
  514.     check_write_type(*op, t_string);
  515.     if (r_size(op) != sizeof(double))
  516.     return_error(e_typecheck);
  517.     return double_params(op - 1, count, pval);
  518. }
  519.  
  520. /* Return a double result. */
  521. private int
  522. double_result(i_ctx_t *i_ctx_p, int count, double result)
  523. {
  524.     os_ptr op = osp;
  525.     os_ptr op1 = op - count;
  526.  
  527.     ref_assign_inline(op1, op);
  528.     memcpy(op1->value.bytes, &result, sizeof(double));
  529.     pop(count);
  530.     return 0;
  531. }
  532.  
  533. /* Apply a unary function to a double operand. */
  534. private int
  535. double_unary(i_ctx_t *i_ctx_p, double (*func)(P1(double)))
  536. {
  537.     dbegin_unary();
  538.     return double_result(i_ctx_p, 1, (*func)(num));
  539. }
  540.